home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / modula.arc / CROSS1.MOD < prev    next >
Encoding:
Text File  |  1985-05-30  |  3.5 KB  |  172 lines
  1. (* Read a text and generate a cross reference table of all
  2.    words, i.e. sequences of characters that begin with a
  3.    letter and consist of letters and digits only.  Blanks
  4.    ends of lines, and special characters are considered
  5.    to be separators.  Use a binary tree to store the words. *)
  6.  
  7. MODULE cref;
  8.  
  9. FROM Terminal IMPORT WriteString, Write, WriteLn;
  10. FROM InOut    IMPORT OpenInput, CloseInput, Done, Read, WriteCard;
  11. FROM Storage  IMPORT ALLOCATE, DEALLOCATE;
  12.  
  13. CONST c1 = 10;
  14.       c2 = 8;
  15.       c3 = 6;
  16.       c4 = 9999;
  17.  
  18. TYPE alfa = ARRAY [0..c1] OF CHAR;
  19.      wordref = POINTER TO word;
  20.      itemref = POINTER TO item;
  21.      word = RECORD
  22.               key: alfa;
  23.               first,last: itemref;
  24.               left,right: wordref
  25.             END;
  26.      item = RECORD
  27.               lno: CARDINAL;
  28.               next: itemref
  29.             END;
  30.  
  31. VAR root: wordref;
  32.     k,k1,n: INTEGER;
  33.     id,a: alfa;
  34.     ch: CHAR;
  35.  
  36. PROCEDURE compalfa(a,b:alfa):INTEGER;
  37. VAR i,j: INTEGER;
  38.  
  39. BEGIN
  40.   i := 0;
  41.   j := 0;
  42.   LOOP
  43.     IF CAP(a[i]) < CAP(b[i]) THEN
  44.       j := -1; EXIT
  45.     ELSIF CAP(a[i]) > CAP(b[i]) THEN
  46.       j := 1; EXIT
  47.     ELSE
  48.       INC(i)
  49.     END;
  50.     IF i > c1 THEN EXIT END
  51.   END;
  52.   RETURN j;
  53. END compalfa;
  54.  
  55. PROCEDURE search(VAR w1: wordref);
  56. VAR w: wordref;
  57.     x: itemref;
  58.  
  59. BEGIN
  60.   w := w1;
  61.   IF w = NIL THEN
  62.     NEW(w); NEW(x);
  63.     WITH w^ DO
  64.       key := id;
  65.       left := NIL;
  66.       right := NIL;
  67.       first := x;
  68.       last := x
  69.     END;
  70.     x^.lno := n;
  71.     x^.next := NIL;
  72.     w1 := w;
  73.   ELSIF compalfa(id,w^.key) < 0 THEN
  74.     search(w^.left)
  75.   ELSIF compalfa(id,w^.key) > 0 THEN
  76.     search(w^.right)
  77.   ELSE
  78.     NEW(x);
  79.     x^.lno := n;
  80.     x^.next := NIL;
  81.     w^.last^.next := x;
  82.     w^.last := x
  83.   END
  84. END search;
  85.  
  86. PROCEDURE printtree(w: wordref);
  87.  
  88.   PROCEDURE printword(w: word);
  89.   VAR l,i: INTEGER;
  90.       x: itemref;
  91.  
  92.   BEGIN
  93.     Write(' ');
  94.     WriteString(w.key);
  95.     x := w.first;
  96.     l := 0;
  97.     REPEAT
  98.       IF l = c2 THEN
  99.         WriteLn;
  100.         l := 0;
  101.         FOR i := 0 TO c1 DO Write(' ') END
  102.       END;
  103.       INC(l);
  104.       WriteCard(x^.lno,c3);
  105.       x := x^.next
  106.     UNTIL x = NIL;
  107.     WriteLn;
  108.   END printword;
  109.  
  110. BEGIN
  111.   IF w # NIL THEN
  112.     printtree(w^.left);
  113.     printword(w^);
  114.     printtree(w^.right)
  115.   END
  116. END printtree;
  117.  
  118. BEGIN
  119.   root := NIL;
  120.   n := 0; k1 := c1;
  121.   Write(14C);
  122.   OpenInput("MOD");
  123.   Read(ch);
  124.   WHILE Done DO
  125.     IF n = c4 THEN n := 0 END;
  126.     INC(n); WriteCard(n,c3);
  127.     Write(' ');Write(ch);
  128.     WHILE (ch # 36C) AND Done DO
  129.       IF (CAP(ch) >= 'A') AND (CAP(ch) <= 'Z')  THEN
  130.         k := 0;
  131.         REPEAT
  132.           IF k < c1 THEN
  133.             a[k] := ch;
  134.             INC(k);
  135.           END;
  136.           Read(ch);
  137.           Write(ch);
  138.         UNTIL NOT((CAP(ch) >= 'A') AND (CAP(ch) <= 'Z')) OR ((ch >= '0') AND (ch <= '9')) AND Done;
  139.         DEC(k);
  140.         IF k >= k1 THEN
  141.           k1 := k
  142.         ELSE
  143.           REPEAT
  144.             a[k1] := ' ';
  145.             DEC(k1);
  146.           UNTIL k1 = k
  147.         END;
  148.         id := a;
  149.         search(root)
  150.       ELSE
  151.         IF ch = '"' THEN
  152.           REPEAT
  153.             Read(ch);
  154.             Write(ch);
  155.           UNTIL ch = '"'
  156.         ELSIF ch = '{' THEN
  157.           REPEAT
  158.             Read(ch);
  159.             Write(ch);
  160.           UNTIL ch = '}'
  161.         END;
  162.         Read(ch);
  163.         Write(ch)
  164.       END
  165.     END;
  166.     Read(ch);
  167.   END;
  168.   Write(14C);
  169.   printtree(root);
  170.   CloseInput;
  171. END cref.
  172.